home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Tele / Pete Johnson / ff 1.5 source.cpt / HelloTabby.p < prev    next >
Text File  |  1992-02-23  |  16KB  |  453 lines
  1. unit HelloTabby;
  2.  
  3. {     Written by Pete Johnson                                                                                    }
  4. {    Enhancements by Mike Taylor                                                                            }
  5.  
  6. {    Version 1.1 of Feb. 22, 1992 -- adds new log utilities by Mike Taylor                }
  7.  
  8. {    Version 1.0 released June 22, 1991 -- first version number assigned                }
  9.  
  10. { Source for a Think Pascal unit which handles the Tabby launch.next file,                }
  11. { returns the name of the next application to launch in a variable called                    }
  12. { NextLaunch and allows MultiFinder some cycles if the Tabby Setup file                    }
  13. { says Multifinder is running.                                                                                    }
  14.  
  15. {            ********** History **********                                                    }
  16.  
  17. { Modified Mar. 11, 1989, to handle up to 100 events of < 32 chars apiece.            }
  18. { Modified Apr. 17 and May 6, 1989, to handle MultiFinder.                                    }
  19. { Modified June 11, 1989, to use Toolbox file calls.                                                }
  20. { Modified June 15, 1989, to use Tabby Setup name for 'BBS' string.                        }
  21. { Modified July 22, 1989, for additional error checking.                                        }
  22. { Modified Nov. 19, 1989, to add WaitNextEvent delay for MultiFinder                    }
  23. { Modified Jan. 20, 1990, to include all variable declarations necessary --            }
  24. {                        this unit uses no external globals.                                                    }
  25. { Modified Mar. 03, 1990, to use Tabby Setup file rather than Config file for            }
  26. {                        info re: MF, BBSName etc. This allows Mansion                                }
  27. {                        compatibility.                                                                                }
  28. { Modified June 16, 1991, to record default path and some other subtle changes.    }
  29. { Modified June 22, 1991, to make backup of launch.next file in case of error.        }
  30. { Modified Feb. 07, 1992, to add LogThis function and GetDateAndTime procedure. }
  31.  
  32. { This source code is being made public in the hopes that it will lead to more            }
  33. { and better Tabby applications. I ask only that you credit me with a thanks            }
  34. { if you incorporate any or all of this code in an application. If you improve            }
  35. { on this code, please share your ideas.                                                                    }
  36.  
  37. { If you're not using Think Pascal, you're on your own. I'm sure someone                }
  38. { other than me can help you if you need to convert this code for Turbo, TML            }
  39. { or Apple's MPW Pascal.                                                                                        }
  40.  
  41. { Thanks to Erik Selberg, who has been a real help.                                                    }
  42.  
  43. { How to use this code:                                                                                            }
  44.  
  45. {  <1> Create a Think Pascal Project                                                                        }
  46. {  <2> Add the HelloTabby.p file as the first unit                                                        }
  47. {  <3> Create your own additional files                                                                    }
  48.  
  49. { You should include an STR  resource 500 in the Project: this holds the name            }
  50. { of the default launch.next application (usually the BBS application).                        }
  51.  
  52. {   Your main program Unit should include the following lines at its start:                }
  53.  
  54. {     uses                                                                                                                }
  55. {       HelloTabby;                                                                                                    }
  56.  
  57. {   Begin the main procedure of your program as follows:                                        }
  58.  
  59. {    HelloTabby;                                                                                                        }
  60.  
  61. {   End the main procedure of your program as follows:                                            }
  62.  
  63. {    if NextLaunch <> '' then                                                                                    }
  64. {       LaunchNextAppl                                                                                            }
  65. {    end.                                                                                                                    }
  66.  
  67. {    The following global variables are available to your program:                            }
  68.  
  69. {    NextLaunch: STR255;        --    Name of next app to launch, empty if none.                }
  70. {    MultiFinder: boolean;            --    True if Tabby Config says MF, else false.                }
  71. {    Err: OSErr;                        --    General variable you can use for OSErrs.                }
  72. {    vRefNum: integer;                --    Reference number of default volume.                        }
  73. {    dirID: longint;                    --    Reference number of default directory.                    }
  74. {    gDefaultpath: str255            --    Full path to default dir (ends w/colon).                    }
  75. {    gVolName: STR255;            --    Name of default volume.                                        }
  76. {    BBSName: STR255;            --    Name of BBS application                                        }
  77. {    BaudString: STR255;        --    Baud rate from Tabby Setup in ASCII                        }
  78. {    PortString: STR255;            --    'a' = modem, 'b' = printer                                        }
  79.  
  80. interface
  81.  
  82.     type
  83.         pLaunchStruct = ^LaunchStruct;
  84.         LaunchStruct = record
  85.                 pfName: StringPtr;
  86.                 param: INTEGER;
  87.                 LC: packed array[0..1] of CHAR;    {    extended parameters:                                    }
  88.                 extBlockLen: LONGINT;                         {    number of bytes in extension = 6                    }
  89.                 fFlags: INTEGER;                                {    Finder file info flags                                        }
  90.                 launchFlags: LONGINT;                         {    bit 31,30=1 for sublaunch, others reserved    }
  91.             end;                                                     {    LaunchStruct                                                    }
  92.  
  93.     const
  94.         sleep = 10;
  95.         Format = 0;
  96.  
  97.     var
  98.         NextLaunch, gVolName, BBSName, BaudString, PortString, gDefaultpath: STR255;
  99.         MultiFinder: boolean;
  100.         Err: OSErr;
  101.         dirID: longint;
  102.         vRefNum: integer;
  103.         IgnoreBool: boolean;                {    These variables for WaitNextEvent calls    }
  104.         TabbyEventRec: EventRecord;
  105.  
  106.     function PathNameFromDirID (DirID: longint; vRefNum: integer): str255;
  107.  
  108.     procedure LaunchNextAppl;
  109.  
  110.     procedure HelloTabby;
  111.  
  112.     procedure ReadTabbyConfig;
  113.  
  114.     procedure GetDateAndTime (var DateTime: str255);
  115.     { returns 'mm/dd/yy hh:mm:ss'}
  116.  
  117.     function ReadALine (FileRefNum: integer; var TheMessage: string): OSErr;    {very useful!}
  118.  
  119.     function LogThis (ProgName, StringToLog: string): OSErr;
  120.      { LogThis logs a string into the Tabby Log for your application        }
  121.      { in the form 'mm/dd/yy hh:mm:ss ProgName - StringToLog'        }
  122.  
  123.  
  124. implementation
  125.  
  126. {-----------------------------------------------------------------    }
  127.  
  128.     function Int2Char (Number: integer): char;
  129.  
  130. { Function changes integer to character.                                  }
  131.  
  132.     begin
  133.         Int2Char := chr(Number + ord('0'));
  134.     end;
  135.  
  136. { ------------------------------------------------------ }
  137.  
  138.     function BigString (Number: integer): string;
  139.  
  140. { Function changes two-digit number to a two-character string.           }
  141.  
  142.     begin
  143.         BigString := concat(Int2Char(Number div 10), Int2Char(Number mod 10));
  144.     end;
  145.  
  146. { ------------------------------------------------------ }
  147.  
  148.     procedure GetDateAndTime; {(VAR DateTime: Str255)}
  149.  
  150.         var
  151.             dtr: DateTimeRec;
  152.  
  153.     begin
  154.         GetTime(DTR);
  155.         DateTime := concat(BigString(dtr.Month), '/');
  156.         DateTime := concat(DateTime, BigString(dtr.Day), '/');
  157.         DateTime := concat(DateTime, BigString(dtr.Year - 1900));
  158.         DateTime := concat(DateTime, ' ', BigString(dtr.Hour), ':');
  159.         DateTime := concat(DateTime, BigString(dtr.Minute), ':');
  160.         DateTime := concat(DateTime, BigString(dtr.Second))
  161.     end;
  162.  
  163. { ------------------------------------------------------ }
  164.  
  165.     function LogThis; {(ProgName, StringToLog: STRING): OSErr}
  166.  
  167.         var
  168.             StrLen: longint;
  169.             LogString: string;
  170.             LogPath, TheDate: Str255;
  171.             fndrInfo: FInfo;
  172.             TLRefNum: integer;
  173.  
  174.     begin
  175.         LogPath := concat(gDefaultPath, 'Tabby:Tabby Log');
  176.         Err := GetFInfo(LogPath, vRefNum, fndrInfo);
  177.         if Err = FNFErr then
  178.             Err := Create(LogPath, vRefNum, 'QED1', 'TEXT');
  179.  
  180.         if Err = NoErr then
  181.             Err := FSOpen(LogPath, vRefNum, TLRefNum);
  182.  
  183.         if Err = NoErr then
  184.             begin
  185.                 GetDateAndTime(TheDate);
  186.                 LogString := concat(TheDate, ' ', ProgName, ' - ', StringToLog, chr(13));
  187.                 StrLen := longint(length(LogString));
  188.                 Err := SetFPos(TLRefNum, FSFromLEOF, 0);
  189.                 if Err = NoErr then
  190.                     Err := FSWrite(TLRefNum, StrLen, @LogString[1])
  191.             end;
  192.         LogThis := Err;
  193.         Err := FSClose(TLRefNum)
  194.     end;
  195.  
  196. { ------------------------------------------------------ }
  197.  
  198.     function ReadALine;        {    (FileRefNum: integer; var TheMessage: string): OSErr;    }
  199.  
  200.         var
  201.             myPB: ParamBlockRec;
  202.             myString: Str255;
  203.  
  204.     begin
  205.         myString := '';
  206.         myPB.ioCompletion := nil;
  207.         myPB.ioRefNum := FileRefNum;
  208.         myPB.ioBuffer := Pointer(@myString[1]);
  209.         myPB.ioReqCount := 255;
  210.         myPB.ioPosMode := 3456; {ASCII 13*256+128}
  211.         myPB.ioPosOffset := 0; {ignored}
  212.         ReadALine := PBRead(@myPB, False);
  213.         if (myString[myPB.ioActCount] = chr(13)) then
  214.             myString[0] := char(myPB.ioActCount - 1) {Drop CR}
  215.         else
  216.             myString[0] := char(myPB.ioActCount);
  217.         TheMessage := myString
  218.     end;
  219.  
  220. {-----------------------------------------------------------------    }
  221.  
  222.     procedure ReadTabbyConfig;
  223.  
  224.         var
  225.             ConfigRefNum, MFCount: integer;
  226.             OneLine: str255;
  227.  
  228.     begin
  229.         Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, ConfigRefNum);
  230.         if Err = noErr then
  231.             begin
  232.                 Err := ReadALine(ConfigRefNum, BBSName);    {    Name of BBS application        }
  233.                 Err := ReadALine(ConfigRefNum, OneLine);    {    MF status: 1 true, 0 false        }
  234.                 if OneLine[1] = '1' then
  235.                     begin
  236.                         MultiFinder := true;
  237.     {    We now have a valid boolean value for MultiFinder, so let's yield time if appropriate.    }
  238.     {    10 ticks (1/6 sec) times 20 = 3.2 seconds -- same value Michael Connick uses.            }
  239.                         for MFCount := 1 to 20 do
  240.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
  241.                     end
  242.                 else
  243.                     MultiFinder := false;
  244.                 Err := ReadALine(ConfigRefNum, BaudString);    {    Baud rate in ASCII                }
  245.                 Err := ReadALine(ConfigRefNum, PortString)        {    'a' = modem, 'b' = printer    }
  246.             end;        {    if Err = noErr    }
  247.         Err := FSClose(ConfigRefNum)
  248.     end;
  249.  
  250. { ------------------------------------------------------ }
  251.  
  252.     function Launchit (pLnch: pLaunchStruct): OSErr;
  253.  
  254.     inline
  255.         $205F, $A9F2, $3E80;
  256.  
  257. { ------------------------------------------------------ }
  258.  
  259.     procedure LaunchNextAppl;
  260.  
  261.         var
  262.             pMyLaunch: pLaunchStruct;
  263.             myLaunch: LaunchStruct;
  264.             MyPB: CInfoPBRec;
  265.             MFCount: integer;
  266.  
  267.     begin
  268.  
  269.         with MyPB do
  270.             begin
  271.                 ioNamePtr := @NextLaunch;
  272.                 ioVRefNum := vRefNum;
  273.                 ioFDirIndex := 0;
  274.                 ioDirID := 0;
  275.             end;    {    with    }
  276.         Err := PBGetCatInfo(@MyPB, false);
  277.  
  278.         pMyLaunch := @myLaunch;
  279.         with pMyLaunch^ do
  280.             begin
  281.                 pfName := @NextLaunch;
  282.                 param := 0;
  283.                 LC[0] := 'L';
  284.                 LC[1] := 'C';
  285.                 extBlockLen := 6;
  286.                 fFlags := myPB.ioFlFndrInfo.fdFlags;
  287.                 if MultiFinder then
  288.                     LaunchFlags := $C0000000            {    set BOTH high bits for a sublaunch        }
  289.                 else
  290.                     LaunchFlags := $00000000;        {    just launch, then quit                            }
  291.             end;                                                {    with pMyLaunch^                                }
  292.         if MultiFinder then
  293.             for MFCount := 1 to 20 do
  294.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);    {    Give away more cycles    }
  295.         Err := Launchit(pMyLaunch)
  296.     end;
  297.  
  298. { ------------------------------------------------------ }
  299.  
  300.     function PathNameFromDirID;{ (DirID: longint; vRefNum: integer): str255}
  301.  
  302.         var
  303.             Block: CInfoPBRec;
  304.             directoryName, FullPathName: str255;
  305.  
  306.     begin
  307.         FullPathName := '';
  308.         with Block do
  309.             begin
  310.                 ioNamePtr := @directoryName;
  311.                 ioDrParID := DirID
  312.             end;
  313.  
  314.         repeat
  315.             with Block do
  316.                 begin
  317.                     ioVRefNum := vRefNum;
  318.                     ioFDirIndex := -1;
  319.                     ioDrDirID := Block.ioDrParID
  320.                 end;
  321.             err := PBGetCatInfo(@Block, FALSE);
  322.  
  323.             directoryName := concat(directoryName, ':');
  324.             FullPathName := concat(directoryName, FullPathName)
  325.         until (Block.ioDrDirID = fsRtDirID);
  326.  
  327.         PathNameFromDirID := FullPathName
  328.     end;
  329.  
  330. { ------------------------------------------------------ }
  331.  
  332.     procedure HelloTabby;
  333.  
  334. { This procedure looks for a Tabby launch.next file. If it's found, it                 }
  335. { extracts the events, which are comma delimited, saves the first one            }
  336. { for the next launch and rewrites the file from event #2 to the last                }
  337. { event.                                                                                                            }
  338.  
  339. { If it finds only one event, it kills the launch.next file.                                   }
  340.  
  341. { If there are no events, it returns the application name contained in                }
  342. { STR  500 as STR255 NextLaunch, otherwise it uses NextLaunch to hold          }
  343. { the first entry in the launch.next script.                                                         }
  344.  
  345. { Before returning, it also checks that the NextLaunch application exists        }
  346. { by trying to open it. If the open attempt fails, it returns NextLaunch            }
  347. { as an empty string.                                                                                        }
  348.  
  349.         type
  350.             HundredEvents = array[1..100] of string[32];
  351.             ManyChars = packed array[1..3300] of char;    {    Can hold 100 32-length events, commas and one <CR>    }
  352.  
  353.         var
  354.             EventCounter, EventLimit, LNRefNum, LaunchCount: integer;
  355.             LNChar: char;
  356.             TheChars: ManyChars;
  357.             Event: HundredEvents;
  358.             Events, ThisEvent, TempString, BBSName: STR255;
  359.             logicalEOF, Quantity, CharIndex: longint;
  360.             CharCount, SetUpRef, SetUpCount: integer;
  361.             fndrInfo: FInfo;
  362.  
  363.     begin
  364.         SetCursor(GetCursor(WatchCursor)^^);
  365.         Err := HGetVol(@gVolName, vRefNum, dirID);        { Get volume ref # & dirID for default volume    }
  366.         gDefaultpath := PathNameFromDirID(dirID, vRefNum);    { Get full pathname                            }
  367.         Events := '';
  368.         for EventCounter := 1 to 100 do
  369.             Event[EventCounter] := '';
  370.         ThisEvent := '';
  371.         LNChar := chr(255);                            {    Dummy value so we can spot this first time through    }
  372.         NextLaunch := GetString(500)^^;        {    Get next launch string from resource                            }
  373.         ReadTabbyConfig;                                {    See if we're running MultiFinder & yield time if so        }
  374.         EventCounter := 1;
  375.         Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
  376.         Err := GetEOF(LNRefNum, logicalEOF);
  377.         if (logicalEOF > 0) and (Err = NoErr) then
  378.             begin
  379.                 Err := SetFPos(LNRefNum, fsFromStart, 0);
  380.                 LaunchCount := 0;
  381.                 while (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
  382.                     begin
  383.                         if MultiFinder then
  384.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  385.                         while (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
  386.                             begin
  387.                                 if (LNChar <> chr(255)) then
  388.                                     ThisEvent := concat(ThisEvent, LNChar);
  389.                                 LaunchCount := LaunchCount + 1;
  390.                                 Quantity := 1;
  391.                                 Err := FSRead(LNRefNum, Quantity, @LNChar);
  392.                                 LNChar := chr(ord(LNChar) div 256);
  393.                             end;            { (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
  394.                         Event[EventCounter] := ThisEvent;
  395.                         EventCounter := EventCounter + 1;
  396.                         ThisEvent := '';
  397.                         LNChar := chr(255)
  398.                     end;            { (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
  399.                 Err := FSClose(LNRefNum);
  400.                 Err := FSDelete(concat(gDefaultpath, 'launch.next'), vRefNum);
  401.                 EventLimit := (EventCounter - 2);
  402.                 if EventLimit > 1 then
  403.                     begin
  404.                         Err := Create(concat(gDefaultpath, 'launch.next'), vRefNum, 'QED1', 'TEXT');
  405.                         Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
  406.                         Err := SetFPos(LNRefNum, fsFromStart, 0);
  407.                         CharIndex := 0;
  408.                         for EventCounter := 2 to EventLimit do
  409.                             begin
  410.                                 if MultiFinder then
  411.                                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  412.                                 TempString := Event[EventCounter];
  413.                                 for CharCount := 1 to length(TempString) do
  414.                                     TheChars[CharIndex + CharCount] := TempString[CharCount];
  415.                                 CharIndex := CharIndex + length(TempString) + 1;
  416.                                 if EventCounter <> EventLimit then
  417.                                     TheChars[CharIndex] := ','
  418.                                 else
  419.                                     TheChars[CharIndex] := chr(13)
  420.                             end; {Counter loop}
  421.                         Err := FSWrite(LNRefNum, CharIndex, @TheChars);
  422.                         Err := FSClose(LNRefNum);
  423.                         Err := FlushVol(@gVolName, vRefNum)
  424.                     end; {EventLimit > 1}
  425.                 if EventLimit > 0 then
  426.                     NextLaunch := Event[1];
  427.                 TempString := NextLaunch;
  428.                 UprString(TempString, false);
  429.                 if TempString = 'BBS' then
  430.                     begin
  431.                         Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, SetupRef);
  432.                         if Err = NoErr then
  433.                             Err := GetEOF(SetupRef, logicalEOF);
  434.                         if (logicalEOF > 0) & (Err = NoErr) then
  435.                             begin
  436.                                 Err := ReadALine(LNRefNum, NextLaunch);
  437.                                 Err := FSClose(SetupRef);
  438.                             end        {    if logicalEOF > 0 for 'Tabby Setup'    }
  439.                     end;        {    if TempString = 'BBS'     }
  440.             end        {    if logicalEOF > 0 for 'launch.next'    }
  441.         else
  442.             begin
  443.                 Err := FSClose(LNRefNum);
  444.                 Err := FSDelete(concat(gDefaultpath, 'launch.next.bak'), vRefNum);
  445.                 Err := Rename(concat(gDefaultpath, 'launch.next'), vRefNum, concat(gDefaultpath, 'launch.next.bak'))
  446.             end;
  447.         Err := GetFInfo(NextLaunch, vRefNum, fndrInfo);    {    Is it an application?    }
  448.         if (Err <> noErr) | (fndrInfo.fdType <> 'APPL') then
  449.             NextLaunch := '';
  450.         if MultiFinder then
  451.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
  452.     end;            { HelloTabby procedure }
  453. end.                { Unit }